BEGIN "NSORTR"
REQUIRE "DDSUB.SAI[GRA,HPM]" SOURCE_FILE;
REQUIRE "PRANDR.SAI[BIG,HPM]" SOURCE_FILE;

WHILE TRUE DO
   BEGIN
   INTEGER XXTN,N,NOPEN,NEL,NN,P,FOO,CHN;
   BOOLEAN BIZY;
   OUTSTR("N:"); NN←CVD(INCHWL);
   OUTSTR("P:"); P←CVD(INCHWL);
   RDDCHN(CHN);
   SHOW(-1);
   N←NN↑P;
   NOPEN←NN;
   NEL←NN↑P+2*NN-3;
   OUTSTR("N "&CVS(N)&"  NOPEN "&CVS(NOPEN)&"  NEL "&CVS(NEL)&'15&'12);

      BEGIN
      INTEGER ARRAY WIRE[0:N-1,0:NEL-1],STATE[0:N-1,0:NEL-1],NSIZ,NSET[0:NEL-1];
      INTEGER ARRAY NEXT,PERM,OUTPUT,INPUTMAP[0:N*NOPEN-1];
      REAL ARRAY X,Y[0:NEL-1];

      PROCEDURE WIREIT;
         BEGIN
         INTEGER I,J,K,L,M;

         PROCEDURE SET(INTEGER L; REAL XV,YV);
            BEGIN X[L]←XV; Y[L]←YV; XXTN←XXTN MAX X[L]+1; END;

         XXTN←0;

         FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO INPUTMAP[I]←I MOD NOPEN;

         FOR I←0 STEP 1 UNTIL NOPEN-1 DO
            BEGIN
            SET(I,1,I+1);
            NSIZ[I]←N;
            FOR J←0 STEP 1 UNTIL N-1 DO
               WIRE[J,I]←J+I+NOPEN-1;
            END;
         
         WIRE[0,0]←-1; WIRE[N-1,NOPEN-1]←-N*NOPEN;

         K←-1;
         FOR I←0 STEP 1 UNTIL NEL-NOPEN-1 DO
            BEGIN
            SET(I+NOPEN,2,1+(NOPEN-1)*I/(NEL-NOPEN-1));
            NSIZ[I+NOPEN]←(I+2) MIN (NEL-NOPEN-1-I+2) MIN NOPEN;
            FOR J←0 STEP 1 UNTIL NSIZ[I+NOPEN]-1 DO WIRE[J,I+NOPEN]←(K←K-1);
            END;

         END;
      INTEGER DONE,FOO,I,J,K,L;
      STRING S; BOOLEAN FIRST,PASS;

      PROCEDURE FOLLOW;
         BEGIN
         INTEGER I,J,K,L;
         DONE←0;
         WHILE DONE<NEL DO FOR I←0 STEP 1 UNTIL NEL-1 DO IF NSET[I]=NSIZ[I] THEN
            BEGIN
            FOR J←1 STEP 1 UNTIL NSIZ[I]-1 DO FOR K←0 STEP 1 UNTIL J-1 DO
               IF STATE[J,I]>STATE[K,I] THEN STATE[J,I]↔STATE[K,I];
            FOR J←0 STEP 1 UNTIL NSIZ[I]-1 DO
               BEGIN
               K←WIRE[J,I];
               IF K≥0 THEN
                  BEGIN
                  L←NSET[K];
                  NSET[K]←L+1;
                  STATE[L,K]←STATE[J,I];
                  END
               ELSE
                  OUTPUT[-1-K]←STATE[J,I];
               END;
            NSET[I]←-NSIZ[I];
            DONE←DONE+1;
            END;
         END;

      PROCEDURE DRAW;
         BEGIN
         INTEGER I,J,K;
         DDINIT;
         SCREEN(-1,-.2,XXTN+2,NOPEN+1.2);
         DRKEN; RECTAN(-100,-100,100,100); LITEN;
         FOR I←0 STEP 1 UNTIL NEL-1 DO
            RECTAN(X[I]-.1,Y[I]-.2*NSIZ[I]/N,X[I]+.2,Y[I]+.2*NSIZ[I]/N);
         FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO
            LINE(0,I*(NOPEN+1)/(N*NOPEN-1),X[INPUTMAP[I]],Y[INPUTMAP[I]]);
         FOR I←0 STEP 1 UNTIL NEL-1 DO
         FOR J←0 STEP 1 UNTIL NSIZ[I]-1 DO
            BEGIN REAL FX,FY;
            FX←X[I]+.2; FY←Y[I]+NSIZ[I]*(J/(NSIZ[I]-1)-.5)*.4/N;
            IF WIRE[J,I]<0 THEN LINE(FX,FY,XXTN,(-1-WIRE[J,I])*(NOPEN+1)/(N*NOPEN-1))
               ELSE LINE(FX,FY,X[WIRE[J,I]],Y[WIRE[J,I]]);
            END;
         OUTSTR("CHANNEL "&CVOS(CHN←GDDCHN(-1))&'15&'12);
         FOR I←1,2,3 DO DPYUP(CHN);
         SHOWA(CHN);
         END;

      STRING PROCEDURE POUT(INTEGER I);
         BEGIN INTEGER J;
         J←1; WHILE N*NOPEN≥10↑J DO J←J+1;
         SETFORMAT(J+1,0);
         RETURN(IF N*NOPEN>27 THEN CVS(I) ELSE '77+I);
         END;
      WIREIT;
      DRAW;
         BEGIN
         INTEGER ARRAY CNTR[1:N*NOPEN];
         INTEGER ARRAY CHECK[0:N*NOPEN,0:N*NOPEN];
         INTEGER MAXTRIAL,ACTTRIAL;
         FOR I←1 STEP 1 UNTIL N*NOPEN DO CNTR[I]←(N*NOPEN-I)%N;
         FIRST←TRUE;
         MAXTRIAL←10;
         ACTTRIAL←0;
         DO
            BEGIN
            K←-1;
            FOR I←N-1 STEP -1 UNTIL 0 DO FOR J←N*NOPEN STEP -1 UNTIL 1 DO
               IF CNTR[J]=I THEN PERM[K←K+1]←J;
            DRKEN; RECTAN(-100,-100,0,100); LITEN;
            FOR K←0 STEP 1 UNTIL N*NOPEN-1 DO
               BEGIN
               TXTPOS(-1.2/N-.01,(K-.5)*(NOPEN+1)/(N*NOPEN-1)-.04/N+.6/N,
                  .07/(IF N*NOPEN>27 THEN 2 ELSE 1),.6/N);
               TEXT(POUT(PERM[K]));
               END;
            FOR I←0 STEP 1 UNTIL NEL-1 DO NSET[I]←0;
            FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO
               BEGIN
               K←INPUTMAP[I];
               L←NSET[K];
               NSET[K]←L+1;
               STATE[L,K]←PERM[I];
               END;
            FOLLOW;
            PASS←FALSE;
            FOR K←0 STEP 1 UNTIL N*NOPEN-1 DO
               BEGIN
               L←0; WHILE CHECK[K,L]≠0∧CHECK[K,L]<OUTPUT[K] DO L←L+1;
               IF CHECK[K,L]≠OUTPUT[K] THEN
                  BEGIN
                  WHILE OUTPUT[K]≠0 DO
                     BEGIN
                     CHECK[K,L]↔OUTPUT[K];
                     L←L+1;
                     END;
                  PASS←TRUE;
                  END;
               END;
            ACTTRIAL←ACTTRIAL+1;
            IF PASS THEN
               BEGIN
               MAXTRIAL←MAXTRIAL MAX ACTTRIAL;
               ACTTRIAL←0;
               DRKEN; RECTAN(XXTN+.01,-100,100,100); LITEN;
               FOR K←0 STEP 1 UNTIL N*NOPEN-1 DO
                  BEGIN
                  TXTPOS(XXTN+.03,(K-.5)*(NOPEN+1)/(N*NOPEN-1)-.04/N+.6/N,
                     .07/(IF N*NOPEN>27 THEN 2 ELSE 1),.6/N);
                  L←0; WHILE CHECK[K,L]≠0 DO TEXT(POUT(CHECK[K,(L←L+1)-1]));
                  END;
               DPYUP(CHN);
               END;
            PWITHR(CNTR,N*NOPEN,FIRST);
            INCHSL(BIZY);
            END UNTIL ¬BIZY ∨ ACTTRIAL>10*MAXTRIAL;
            BEGIN
            INTEGER ARRAY BATCH[0:N*NOPEN-1];
            FOR I←0 STEP 1 UNTIL NEL-1 DO
               FOR J←0 STEP 1 UNTIL NSIZ[I]-1 DO
                  IF WIRE[J,I]<0 THEN BATCH[-1-WIRE[J,I]]←I;
            OPEN(1,"DSK",0,0,2,FOO,FOO,FOO);
            SETFORMAT(0,0);
            ENTER(1,CVS(NOPEN)&"."&CVS(P),FOO);
            I←BATCH[N*NOPEN-1];
            FOR K←N*NOPEN-1 STEP -1 UNTIL 0 DO
               BEGIN
               IF I≠BATCH[K] THEN
                  BEGIN
                  OUT(1,'15&'12);
                  I←BATCH[K];
                  END;
               L←0;
               WHILE CHECK[K,L]≠0 DO OUT(1,POUT(CHECK[K,(L←L+1)-1]));
               OUT(1,'15&'12);
               END;
            CLOSE(1);
            OUTSTR("OKAY"&'15&'12&'12);
            END;
         END;

      END;
   END;
END;